/* Creme Caramel Compiler (Triple C) - Michele Caceffo - 2008 */

%{ (* HEADER *)

open Syntaxtree;;

%}

%token <string>   IDE
%token <int>      NUM
%token <float>    REAL
%token <int>      OFFSET /*(* LDL: allow direct offsets to be values *)*/

%token            NULL /*(* LDL: for assignment of the NULL pointer *)*/

%token            TRUE FALSE

%token            PROGRAM VAR ARRAY OF INT FLOAT PROCEDURE FUNCTION BEGIN END 
%token            IF THEN ELSE WHILE DO REPEAT UNTIL FOR TO WRITE CALL 
%token            TYPE RECORD /*(* LDL: new keyword token *)*/

%token            HAT AT /*(* LDL: declare those tokens *)*/
%token            PLUS MINUS TIMES DIVISION EQUAL LESSEQUAL LESS AND OR NOT 
%token            ASSIGN

%token            SEMICOLON COLON COMMA DOT /*(* LDL: add the DOT token *)*/

%token            LS RS LP RP LB RB /*(* LDL: add LB and RB *)*/

%token            EOF

%nonassoc         UMINUS

%start program
%type<Syntaxtree.program> program

%%

/*(* LDL: add an optional type list *)*/
program
    : PROGRAM opt_type_dec_list opt_dec_list opt_proc_list cmd EOF  { Program($2,$3,$4,$5) }
    ;

opt_type_dec_list
    :                                             { [] }
    | type_dec_list                               { $1 }
    ;

type_dec_list
    : type_dec                                    { [$1] }
    | type_dec /*(*SEMICOLON*)*/ type_dec_list    { $1::$2 }
    ;

type_dec
    : TYPE ide EQUAL type_                        { TypeDef($2,$4) }
    ;

type_
    : record_def                                  { TRecord($1) }
;

record_def
    : RECORD LB record_field_list RB              { $3 }
;

record_field_list
    : record_field /*(* SEMICOLON *)*/            { [$1] }
    | record_field SEMICOLON record_field_list    { $1 :: $3 }
;

record_field
    : ide COLON bType                             { TRecordField($1, $3) }
;

/*(* LDL: --------------------------------------------------------------------- *)*/

opt_dec_list
    :                                             { [] }
    | dec_list                                    { $1 }
    ;

dec_list
    : dec                                         { [$1] }
    | dec SEMICOLON dec_list                      { $1::$3 }
    ;

dec
    : VAR ide COLON gType                         { Dec($2,$4) }
    ;

gType
    : bType                                       { Basic($1) }
    | pType                                       { $1 } /*(* LDL: allow the pointer type as a gType *)*/
    | ARRAY LS NUM RS OF bType                    { Vector($3,$6) }
    | ARRAY LS NUM COMMA NUM RS OF bType          { Matrix($3,$5,$8) }
    ;

/*(* LDL: define the pointer type as a ^ followed by either a basic type or another pointer.
          Note that we don't allow neither Matrices nor Vectors to be pointed values.
  *)*/
pType
    : HAT bType                                   { Pointer(Basic($2)) }
    | HAT pType                                   { Pointer($2) }
;

bType
    : INT                                         { Int }
    | FLOAT                                       { Float }
    | ide                                         { UsrType(UsrRecord(Record([$1]))) }
    ;

opt_proc_list
    :                                             { [] }
    | proc_list                                   { $1 }
    ;

proc_list
    : proc                                        { [$1] }
    | proc SEMICOLON proc_list                    { $1::$3 }
    ;

proc
    : PROCEDURE ide LP opt_param_list RP opt_dec_list cmd
	                                          { Proc($2,$4,$6,$7) }
    | FUNCTION ide LP opt_param_list RP COLON ret opt_dec_list cmd
	                                          { Func($2,$4,$7,$8,$9) }
    ;

opt_param_list
    :                                             { [] }
    | param_list                                  { $1 }
    ;

param_list
    : param                                       { [$1] }
    | param COMMA param_list                      { $1::$3 }
    ;

param
    /*(* LDL: note that records are automatically inserted *)*/
    : ide COLON gType                             { Par($1,$3) }
    ;

ret
    : bType                                       { Ret($1) }
    ;

/*(* LDL: enrich cmd to allow pointer value assignments, that are not arithmetic operations
           This means that while aexp assignments will evaluate to an arithmetic value under
           static type checking (even if pointer rules are used, in fact they will not output
           pointers but only values), the pvalue assignment will evaluate to a proper pointer.
*)*/
cmd
    : lexp ASSIGN aexp                            { Ass($1,$3) }
    | lexp ASSIGN pvalue                          { PAss($1,$3) }
    | BEGIN opt_cmd_list END                      { Blk($2) }
    | IF bexp THEN cmd ELSE cmd                   { Ite($2,$4,$6) }
    | WHILE bexp DO cmd                           { While($2,$4) }
    | REPEAT cmd UNTIL bexp                       { Repeat($2,$4) }
    | FOR ide ASSIGN aexp TO aexp DO cmd          { For($2,$4,$6,$8) }
    | WRITE aexp                                  { Write($2) }
    | CALL ide LP opt_actual_list RP              { PCall($2,$4) }
    ;

opt_cmd_list
    :                                             { [] }
    | cmd_list                                    { $1 }
    ;

cmd_list
    : cmd                                         { [$1] }
    | cmd SEMICOLON cmd_list                      { $1::$3 }
    ;

/*(* LDL: we allow left expressions to be dereferenced pointers and records. *)*/
lexp
    : ide                                         { LVar($1) }
    | record_ide                                  { LRec(Record($1)) }
    | deref                                       { LPexpr($1) }
    | ide LS aexp RS                              { LVec($1,$3) }
    | ide LS aexp COMMA aexp RS                   { LMat($1,$3,$5) }
    ;

bexp_factor
    : TRUE                                        { B(true) }
    | FALSE                                       { B(false) }
    | aexp EQUAL aexp                             { Equ($1,$3) }
    | aexp LESSEQUAL aexp                         { LE($1,$3) }
    | aexp LESS aexp                              { LT($1,$3) }
    | NOT bexp_factor                             { Not($2) }
    | LP bexp RP                                  { $2 }
    ;

bexp_term
    : bexp_term AND bexp_factor                   { And($1,$3) }
    | bexp_factor                                 { $1 }
    ;

bexp
    : bexp OR bexp_term                           { Or($1,$3) }
    | bexp_term                                   { $1 }
    ;
   
/*(* LDL: an arithmetical expressions could be formed by a dereferenced pointer or a record *)*/
aexp_factor
    : NUM                                         { N($1) }
    | REAL                                        { R($1) }
    /*(* LDL: assign the offset to the offset AST node *)*/
    | OFFSET                                      { Ox($1) }
    | NULL                                        { PNull }
    | ide                                         { Var($1) }
    | record_ide                                  { Rec(Record($1)) }
    | deref                                       { P($1) }
    | ide LS aexp RS                              { Vec($1,$3) }
    | ide LS aexp COMMA aexp RS                   { Mat($1,$3,$5) }
    | CALL ide LP opt_actual_list RP              { FCall($2,$4) }
    | LP aexp RP                                  { $2 }
    ;

aexp_term
    : aexp_term TIMES aexp_factor                 { Mul($1,$3) }
    | aexp_term DIVISION aexp_factor              { Div($1,$3) }
    | aexp_factor                                 { $1 };
    ;

aexp
    : aexp PLUS aexp_term                         { Sum($1,$3) }
    | aexp MINUS aexp_term                        { Sub($1,$3) }
    | aexp_term                                   { $1 }
    ;

opt_actual_list
    :                                             { [] }
    | actual_list                                 { $1 }
    ;

actual_list
    : actual                                     { [$1] }
    | actual COMMA actual_list                   { $1::$3 }
    ;

/*(* LDL: define what an actual parameter can be *)*/
actual
    : aexp                                        { ParamAexp($1) } /*(* LDL: build an aexp parameter *)*/
    | pactual                                     { ParamPexp($1) } /*(* LDL: build an pexp parameter *)*/

/*(* LDL: pointer value for the actual parameters passed to functions and procedures *)*/
pactual
    : pvalue                                      { $1 }

/*(* LDL: pointer value for the right part of the assignment.
          Note that we cannot have directly a variable here, so aliasing is not allowed
*)*/
pvalue
    : ref                                         { $1 }

/*(* LDL: rule for referencing a variable.
          Note that it would be erroneous to reference a reference (@@),
           as well as it is pointless to reference a pointer dereference (@^),
         so we structurally cut off this possibilities
*)*/
ref
  : AT pvar                                       { Ref($2) }

/*(* LDL: rule for dereferencing a variable.
          Note that we allow to dereference a pointer dereference (^^),
           but we structurally forbid to dereference a pointer reference (^@).
 *)*/
deref
    : HAT pvar                                    { Deref($2) }
    | HAT deref                                   { Deref($2) }
;

pvar
    : ide                                         { PVar($1) }

record_ide
    : ide DOT ide                                 { $1 :: [$3] }
    | ide DOT record_ide                          { $1 :: $3 }
;

ide
    : IDE                                         { Ide($1) }
    ;

%%

(* FOOTER *)

